home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d16 / wc15_b.arc / HOST.WMS < prev    next >
Encoding:
Text File  |  1991-03-22  |  16.5 KB  |  502 lines
  1. ;Wincomm character based Host Program!
  2. ; to change password edit the next line and recompile
  3. pass$="WINCOMM"
  4. superpass$="WIN3"
  5.                                                        
  6. diag = 1 modem=1
  7. dwndir$ = GETSESSSTR(27)
  8. ports$="com1:,com2:,com3:,com4:"
  9. port$="com1:"
  10.    DIALOGBOX 54, 10, 217, 126, 21, "WinComm Character Based Host"
  11.       LTEXT 3, 6, 208, 16, "The Download Directory to be useed by this Host program must be specified."
  12.       RTEXT 3, 27, 72, 9, "Download Directory:"
  13.       EDIT 78, 25, 134, 12, DWNDIR$
  14.       RTEXT 6, 42, 69, 8, "Password:"
  15.       EDIT 79, 40, 134, 12, pass$
  16.       RTEXT 0, 57, 75, 8, "Super User Password:"
  17.       EDIT 79, 55, 134, 12, superpass$
  18.       RTEXT 15, 71, 59, 8, "Connection:"
  19.       COMBOBOX 79, 69, 46, 42, PORTS$, PORT$
  20.       CHECKBOX 102, 88, 111, 10, "Show File Transfer Status Box", DIAG
  21.       CHECKBOX 6, 88, 93, 10, "Modem Host Connection", MODEM
  22.       DEFPUSHBUTTON 47, 106, 50, 14, "&Ok"
  23.       CANCELBUTTON 124, 106, 50, 14, "&Cancel"
  24.    DEND
  25. DO dg=DIALOG? UNTIL(dg !=255)
  26. if(dg==0) HALT
  27. PUTSESSSTR(27,dwndir$)
  28.  
  29. OPEN("HOST.WSF","",modem+1)             ; this sets modem in answer mode
  30. if(modem) PUTSESSINT(3,0)               ; set for modem
  31. else PUTSESSINT(3,1)
  32. port = VALINT(RIGHT(port$,2))-1
  33. PUTSESSINT(2,port)
  34.  
  35. start_over:
  36. START
  37. DO i = ONLINE? UNTIL(i>0)
  38. if(i>2) GOTO start_over                 ; error on connect
  39. i=0 ptry=0 status=0            ; initailize
  40. cmd_line$ = ""                                                               
  41. ;-----------------------------------------------------------------
  42. main1:
  43. ;-----------------------------------------------------------------
  44.    PROMPT                               
  45.         PKEY(1,27)                      ; if escape is pressed terminate macro
  46.     PSTR(2,2,"^C")                  ; if Ctl "C" is recieved, start
  47.     PSTR(2,2,"^M")                  ; if Ctl "C" is recieved, start
  48.     PWAIT(3,50)            ; wait 5 Seconds for a response
  49.     PDCD(10)                   ; if loss of carrier
  50.    PEND
  51.    DO 
  52.     i=PROMPT?
  53.        IF(i==1) GOTO terminate
  54.        IF(i==2) GOTO welcome
  55.     IF(i==3){
  56.         ptry=ptry+1
  57.         IF(ptry>4) GOTO bye
  58.         SEND("^M^JPress 'Enter' to log on!^M^J")
  59.         GOTO main1
  60.     }
  61.        IF(i==10) GOTO bye
  62.    UNTIL(i)
  63.    ptry=0
  64. ;-----------------------------------------------------------------
  65.  
  66.  
  67. ;-----------------------------------------------------------------
  68. welcome:
  69. ;-----------------------------------------------------------------
  70.        stime = time?
  71.        SEND("^L^M^J^M^J^M^JWelcome to WINCOMM Host Mode!^M^J^M^J^M^")
  72.        SEND("First Name: ")
  73.        pw=0 GOSUB cmd_line
  74.        fname$=cmd_line$
  75.        SEND("^M^J Last Name: ")
  76.        pw=0 GOSUB cmd_line
  77.        lname$=cmd_line$
  78.        SEND("^M^J"+fname$+" "+lname$+"^M^JIs this correct (Y/N)? ")
  79.        PROMPT                             
  80.       PSTR(2,1,"Y")                  ; confirm name
  81.       PSTR(2,2,"N")
  82.       PWAIT(3,600)             ; wait for 60 seconds for a response
  83.       PDCD(3)             ; if loss of carrier leave
  84.        PEND
  85.        DO i=PROMPT? UNTIL(i)
  86.        IF(i==3) GOTO bye
  87.        IF(i==1){
  88.            PRINT("^M^J"+fname$+" "+lname$+"^M^J")
  89.            GOTO pass_wd
  90.        }
  91.        SEND("N^M^J^M^J^M^J")
  92.        GOTO welcome 
  93. pass_wd:
  94.        SEND("^M^J^M^JPassword: ")
  95.        pw=1 GOSUB cmd_line
  96.        IF(CMP(pass$,UPPERCASE(cmd_line$))==1) GOTO check_wfile
  97.        IF(CMP(superpass$,UPPERCASE(cmd_line$))==1){
  98.         status=1 GOTO check_wfile
  99.        }
  100.        SEND("^M^J*** Wrong Password!  Re-Enter ***")
  101.        ptry=ptry+1
  102.        if(ptry<4) GOTO pass_wd
  103.        SEND("^M^J Too many attempts!!  Logging off!")
  104.        i=TIME?+1 DO UNTIL(TIME?>i) 
  105.        GOTO bye
  106.  
  107. check_wfile:
  108.     hs = FOPEN(2,"HOST.MSG")
  109.     if(hs==-1) GOTO menu1
  110.     a$=FREADLN(hs) SEND("^M^J")
  111.     DO
  112.         SEND(a$)
  113.         a$=FREADLN(hs)
  114.     UNTIL(NULL(a$)==1)
  115.     FCLOSE(hs)               ; close the help file
  116.         SEND("^M^JPress Enter to continue:")
  117.     PROMPT                             
  118.         PSTR(2,2,"^M")                 ; if CR send more of help file
  119.         PWAIT(10,600)           ; wait 60 seconds for a response
  120.         PDCD(10)               ; if loss of carrier leave
  121.     PEND
  122.     DO i=PROMPT? UNTIL(i)
  123.     IF(i==10) GOTO bye
  124.  
  125. menu1:
  126.        SEND("^M^J^M^J^M^J^M^J^M^JF)iles  U)pload  D)ownload^M^JH)elp  T)ime  C)hat  G)oodbye^M^J^M^JYour choice? ")
  127.        PROMPT                             
  128.           PKEY(1,27)                     ; if escape is pressed terminate
  129.       PSTR(2,2,"F")                  ; Files
  130.       PSTR(2,3,"U")                  ; Upload
  131.       PSTR(2,4,"H")                  ; Help
  132.       PSTR(2,5,"T")                  ; Time
  133.       PSTR(2,6,"C")                  ; Chat
  134.       PSTR(2,7,"G")                  ; GoodBye
  135.       PSTR(2,10,"D")                 ; DownLoad a file
  136.       PWAIT(7,600)             ; waited 60 seconds for a response
  137.           PDCD(7)             ; we lost carrier
  138.        PEND
  139.        DO i=PROMPT? UNTIL(i)
  140.        IF(i==1) GOTO terminate
  141.        IF(i==2) GOTO do_dir
  142.        IF(i==3) GOTO do_upload
  143.        IF(i==4) GOTO send_help
  144.        IF(i==5) GOTO send_time
  145.        IF(i==6) GOTO do_chat
  146.        IF(i==7) GOTO bye
  147.        IF(i==10) GOTO do_down
  148. ;-----------------------------------------------------------------
  149.  
  150. ;-----------------------------------------------------------------
  151. send_help:
  152. ;-----------------------------------------------------------------
  153. hfile = FOPEN(0,"HOST.TXT")                  ; open 0 = read
  154. IF(hfile == -1){
  155.         ALERT("Cannot find help file 'HHLP.TXT'")
  156.         GOTO menu1
  157. }
  158. GOTO h_prompt
  159. help_prompt:
  160.    SEND("^H ^H^H ^H^H ^H^H ^H^H ^H^H ^H^H")
  161. h_prompt:
  162.    i=0
  163.    WHILE(i<24)
  164.         a$ = FREADLN(hfile)
  165.     IF(NULL(a$) == 0) SEND(a$)
  166.         ELSE{
  167.                 FCLOSE(hfile)
  168.                 GOTO menu1
  169.         }
  170.         i = i+1
  171.    WEND
  172.    SEND("-MORE-")
  173.  
  174. PROMPT                             
  175.     PKEY(1,27)                     ; if escape is pressed terminate macro
  176.     PSTR(2,2,"^M")                 ; if CR send more of help file
  177.     PSTR(2,3,"^C")                 ; if ctl "C" terminate help
  178.     PWAIT(10,600)           ; wait 60 seconds for a response
  179.     PDCD(10)               ; if loss of carrier leave
  180. PEND
  181. DO i=PROMPT? UNTIL(i)
  182. IF(i==2) GOTO help_prompt
  183. FCLOSE(hfile)               ; close the help file
  184. IF(i==10) GOTO bye
  185. IF(i==1) GOTO terminate
  186. IF(i==3) GOTO menu1
  187. ;-----------------------------------------------------------------
  188.  
  189.  
  190.  
  191. ;-----------------------------------------------------------------
  192. do_upload:
  193. ;-----------------------------------------------------------------
  194. SEND("^M^J^M^JA)scii  K)ermit  X)modem  Y)modem Batch^M^J1)Xmodem1K  C)XmodemCRC  G)Ymodem-G Batch^M^JZ)modem^M^J^M^JYour choice? ")
  195. PROMPT                             
  196.         PKEY(1,27)                     ; if escape is pressed terminate
  197.     PSTR(2,2,"K")                  ; Check user selection
  198.     PSTR(2,3,"X")                  
  199.     PSTR(2,6,"Y")
  200.     PSTR(2,4,"1")
  201.     PSTR(2,5,"C")
  202.     PSTR(2,7,"G")
  203.     PSTR(2,8,"Z")
  204.     PSTR(2,10,"^C")                ; if Ctl 'C' recieved leave
  205.     PSTR(2,10,"^M")                ; if <CR> recieved leave
  206.     PSTR(2,11,"A")                 ; if ESC is recieved start
  207.         PWAIT(12,600)               ; wait 60 seconds for a response
  208.         PDCD(12)               ; loss of carrier, leave
  209. PEND
  210.        DO i=PROMPT? UNTIL(i)
  211.        if(i==10) goto menu1
  212.        if(i==12) goto bye
  213.        a$=NEXTCHAR?               ;eat character in case CR was pressed                                                                                
  214. get_name:                                                                                
  215.    SEND("^M^JFile name? ")                                                             
  216.        pw=0 GOSUB cmd_line
  217.        IF(NULL(cmd_line$) == 1) GOTO menu1
  218.        fname$ = cmd_line$
  219.        IF(FOPEN(16384,dwndir$+"\"+fname$) >= 0 ){
  220.                 SEND(" <== File Already exists")
  221.                 GOTO get_name
  222.        }
  223.        hfile = FOPEN(4096,dwndir$+"\"+fname$)
  224.        IF(hfile == -1){
  225.                 SEND(" <== Invalid File Name")
  226.                 GOTO get_name
  227.        }
  228.        FCLOSE(hfile)
  229. SEND("^M^J             |..................|...................|^M^J")
  230. SEND("Description:  ") 
  231. pw=0 GOSUB cmd_line
  232. SEND("^M^JBegin your transfer procedure...")
  233. j = time? + 1
  234. WHILE(time?<j)
  235. WEND
  236. if(i<9){
  237.         PUTSESSINT(6,i-1)
  238.         RECEIVEFILE(diag,fname$)
  239. }
  240. else RECEIVEASCII(diag,fname$)
  241. DO j=XFER? UNTIL(j!=1)
  242. IF(i<9) SEND("^M^J"+STATUSLINE?+"^M^J")                ; send result string to remote end
  243. ELSE SEND("^M^J"+"ASCII Upload Complete!"+"^M^J")        ; send result string to remote end
  244. IF(i==0){
  245.     ht = FOPEN(2,"UPLOADS.TXT")
  246.     if(ht==-1){
  247.         ht=FOPEN(4096,"UPLOADS.TXT")
  248.         if(ht==-1) ALERT( "Cannot Create File -'UPLOADS.TXT'") HALT
  249.     }
  250.     FSEEK(ht,0,2)
  251.     a$=fname$+CHAR(9)+cmd_line$
  252.     FWRITELN(ht,a$)
  253.     FCLOSE(ht)
  254. }
  255. IF(i==5) GOTO bye                    ; loss of carrier during xfer
  256. GOTO menu1                                                                  
  257. ;-----------------------------------------------------------------
  258.  
  259.  
  260.  
  261. ;-----------------------------------------------------------------
  262. do_down:
  263. ;-----------------------------------------------------------------
  264. SEND("^M^J^M^JA)scii  K)ermit  X)modem  Y)modem Batch^M^J1)Xmodem1K  C)XmodemCRC  G)Ymodem-G Batch^M^JZ)modem^M^J^M^JYour choice? ")
  265. PROMPT                             
  266.         PKEY(1,27)                     ; if escape is pressed terminate
  267.     PSTR(2,2,"K")                  ; Check user selection
  268.     PSTR(2,3,"X")                  
  269.     PSTR(2,6,"Y")
  270.     PSTR(2,4,"1")
  271.     PSTR(2,5,"C")
  272.     PSTR(2,7,"G")
  273.     PSTR(2,8,"Z")
  274.     PSTR(2,10,"^C")                ; if Ctl 'C' recieved leave
  275.     PSTR(2,10,"^M")                ; if <CR> recieved leave
  276.     PSTR(2,11,"A")                 ; if ESC is recieved start
  277.         PWAIT(12,600)               ; wait 60 seconds for a response
  278.         PDCD(12)               ; loss of carrier, leave
  279. PEND
  280. DO i=PROMPT? UNTIL(i)
  281. if(i==10) goto menu1
  282. if(i==12) goto bye
  283. get_name1:
  284. a$=NEXTCHAR?                   ;eat character in case CR was pressed                                                                                
  285. SEND("^M^JFile name? ")                                                             
  286.        pw=0  GOSUB cmd_line
  287.        IF(NULL(cmd_line$) == 1) GOTO menu1
  288.        fname$ = cmd_line$
  289.        IF(FOPEN(16384,dwndir$+"\"+fname$) >= 0 ) GOTO beginxfer
  290.        IF(FOPEN(16384,fname$) >= 0 ){
  291.         IF(status) GOTO beginxfer
  292.               SEND(" <== Super User Status required")
  293.             GOTO get_name1
  294.        }
  295.        SEND(" <== File does not exits")
  296.        GOTO get_name1
  297.  
  298. beginxfer:
  299. SEND("^M^JBegin your transfer procedure...")
  300. if(i<9){
  301.         j = time? + 1
  302.         WHILE(time?<j)
  303.         WEND
  304.         PUTSESSINT(6,i-1)
  305.         SENDFILE(diag,fname$)
  306. }
  307. else {
  308.         SEND("^M^JPress <CR> to begin transfer...^M^J(Ctrl-D aborts)? ")
  309.         PROMPT                             
  310.                 PKEY(1,27)                      ; if escape is pressed terminate
  311.         PSTR(2,2,"^M")                  ; if Carrage return recieved
  312.         PSTR(2,3,"^D")                  ; if Ctl 'C' received
  313.         PDCD(4)                            ; if loss of carrier leave
  314.         PWAIT(4,600)                    ; wait 60 seconds for a response
  315.         PEND
  316.         DO i = PROMPT? UNTIL(i)
  317.         IF(i==1) GOTO terminate
  318.         IF(i==3) GOTO menu1
  319.         IF(i==4) GOTO bye
  320.         SENDASCII(diag,fname$)
  321. }
  322. DO j=XFER? UNTIL(j!=1)
  323. IF(j==5) GOTO bye                ; loss of carrier during xfer
  324. IF(i<9) SEND("^M^J"+STATUSLINE?+"^M^J")                ; send result string to remote end
  325. ELSE SEND("^M^J"+"ASCII Download Complete!"+"^M^J")            ; send result string to remote end
  326. GOTO menu1                                                                  
  327. ;-----------------------------------------------------------------
  328.  
  329.  
  330.  
  331. ;-----------------------------------------------------------------
  332. send_time:
  333. ;-----------------------------------------------------------------
  334. SEND("^M^J^M^JOnLine at: "+strtime(stime))
  335. SEND("^M^JIt is now: "+strtime(time?))                                                             
  336. GOTO menu1                                                                  
  337. ;-----------------------------------------------------------------
  338.  
  339.  
  340. ;-----------------------------------------------------------------
  341. do_dir:
  342. ;-----------------------------------------------------------------
  343. SEND("^M^JEnter FILE SPEC:  (Carraige Return = *.*)^M^J> ")
  344. pw=0 GOSUB cmd_line
  345. if(NULL(cmd_line$) == 1) cmd_line$ = "*.*"
  346. SEND("^M^J(Press Ctrl-C to abort display)^M^J")
  347.  
  348. IF(status){
  349.     dir$="" i=1
  350. again:    a$=EXTRACT("\",cmd_line$,i)
  351.     IF(CMP(cmd_line$,a$)==1) GOTO done
  352.     IF(i>1)dir$=dir$+"\"+a$
  353.     ELSE dir$=dir$+a$
  354.     i=i+1 GOTO again
  355. done:     IF(NULL(dir$)==1) dir$=dwndir$
  356.     ELSE SUBST(dir$,cmd_line$,"",1)
  357.     filter$=cmd_line$
  358.     SUBST("\",filter$,"",1)
  359. }
  360. ELSE{
  361.     filter$=cmd_line$
  362.     dir$=dwndir$
  363. }
  364. SEND(dir$+"\"+filter$+"^M^J")
  365. file$ = FILEFIND(dir$+"\"+filter$,16)
  366. ii=1
  367.  
  368. hfile1:
  369.    PROMPT                             
  370.       PKEY(1,27)                             ; if escape is pressed terminate
  371.       PSTR(2,2,"^M")                          ; if ESC is recieved start
  372.       PSTR(2,3,"^C")                          ; if ESC is recieved start
  373.       PWAIT(4,600)                          ; wait for 60 seconds for a response
  374.       PDCD(4)                                  ; loss of carrier leave
  375.    PEND     
  376.    WHILE( (NULL(file$) ==0 ) && (ii<23) )
  377.          hfile = FOPEN(2,dir$+"\"+file$)        ;2 = read
  378.      if(hfile==-1)   SEND(file$+"^I<DIR>^M^J")
  379.      ELSE {    
  380.              i = filesize(hFile)
  381.              j = filetime(hFile)
  382.              FCLOSE(hFile)
  383.              if(len(file$) <8) file$ = file$+"     "
  384.              SEND(file$+"^I"+strint(i)+"^I"+strtime(j)+"^M^J")
  385.      }
  386.          file$= FINDNEXT
  387.          ii = ii+1
  388.    WEND
  389.    IF((NULL(file$) == 1) && (ii<20) ) GOTO menu1
  390.    SEND("-MORE-")
  391.    DO i=PROMPT? UNTIL(i)
  392.    IF(i==1)GOTO terminate
  393.    IF(i==3) GOTO menu1
  394.    IF(i==4) GOTO bye
  395.    SEND("^H ^H^H ^H^H ^H^H ^H^H^H")
  396.    ii=0
  397.    GOTO hfile1
  398. ;-----------------------------------------------------------------
  399.  
  400.  
  401. ;-----------------------------------------------------------------
  402. do_chat:
  403. ;-----------------------------------------------------------------
  404. SEND("^M^J^M^JPaging Host operator.....")
  405. PROMPT                             
  406.   PKEY(1,27)                             ; if escape is pressed host operator has acknowledged
  407. PEND
  408. j = 0
  409. WHILE(j<5)
  410.     ALARM ALARM i=time?+2
  411.         WHILE(time?<i)
  412.         IF(PROMPT?) GOTO in_chat
  413.         WEND
  414.     j=j+1
  415. WEND
  416. SEND("Host operator has been paged.")
  417. GOTO menu1                                                                  
  418.  
  419. in_chat:
  420. SEND("^M^JHost operator is now on-line.^M^J")
  421. PRINT("^M^JHost operator is now on-line.^M^J")
  422. PROMPT                             
  423.   PKEY(1,13)                             ; if 'Enter' is pressed sent linefeed
  424.   PKEY(2,27)                             ; if escape is pressed host operator has acknowledged
  425. PEND
  426. MACROTRAP(1)
  427. DO 
  428.     a$=NEXTCHAR?
  429.     IF(NULL(a$)==0){
  430.         SEND(a$) PRINT(a$)
  431.         if(ASC(a$)==13) SEND("^J")
  432.     }
  433.     i=PROMPT?
  434.     if(i==1){
  435.         SEND("^J")
  436.         PROMPT                             
  437.               PKEY(1,13)
  438.               PKEY(2,27)
  439.         PEND
  440.     }
  441. UNTIL(i==2)
  442. CLEAR
  443. MACROTRAP(0)
  444. GOTO menu1                                                                  
  445. ;-----------------------------------------------------------------
  446.  
  447.  
  448.  
  449.  
  450. ;-----------------------------------------------------------------
  451. cmd_line:       ;pw = 0 char are echoed back 1 "*" are echoed
  452. ;-----------------------------------------------------------------
  453.        cmd_line$=""  cnt=0  delay=TIME?+60 
  454.        MACROTRAP(1)
  455. next_char:
  456.        IF(TIME?>delay){
  457.            MACROTRAP(0) GOTO bye
  458.        }
  459.        a$=NEXTCHAR?
  460.        IF(NULL(a$) == 1) GOTO next_char
  461.        cnt=cnt+1
  462.        IF( (ASC(a$)==13) || (cnt>60) )  GOTO end_getl
  463.        IF(pw != 1) SEND(a$)
  464.        ELSE SEND("*")
  465.        IF(ASC(a$)==8){                    ; back space
  466.                 IF(NULL(cmd_line$)==1){
  467.             cnt=0
  468.             GOTO next_char
  469.         }
  470.         cnt=cnt-2
  471.         IF(cnt<=0){
  472.             cnt=0
  473.             cmd_line$=""
  474.         }
  475.                 ELSE cmd_line$=LEFT(cmd_line$, cnt)
  476.        }
  477.        ELSE cmd_line$=cmd_line$+a$
  478.        GOTO next_char
  479. end_getl:
  480.        MACROTRAP(0)
  481.        cmd_line$ = UPPERCASE(cmd_line$)
  482.        RETURN
  483.        
  484. ;-----------------------------------------------------------------
  485.  
  486.  
  487. bye:
  488. ;-----------------------------------------------------------------
  489.    SEND("^M^J Ending Wincomm Host Mode!")
  490.    i=TIME?+1 DO UNTIL(TIME?>i) 
  491.    STOP  i=TIME?+6 DO UNTIL(TIME?>i) GOTO start_over
  492. ;-----------------------------------------------------------------
  493.  
  494.  
  495. ;-----------------------------------------------------------------
  496. terminate:
  497. ;-----------------------------------------------------------------
  498.      ALERT("Host Macro Will Terminate")
  499.      HALT
  500. ;-----------------------------------------------------------------
  501. END
  502.